perm filename PLOT.SAI[X,ALS]5 blob
sn#078544 filedate 1973-12-21 generic text, type T, neo UTF8
00010 BEGIN "PLOT"
00020 DEFINE ⊂="COMMENT"; ⊂ DEC.11,1973;
00030 ⊂ Modified to use pulse markers and to permit their motion;
00040 DEFINE ⊃="⊂";
00050 DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00060 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00070 LABEL STARTP,STOPP,TOFORM;
00080 ⊂ DEFINE \=" "; DEFINE \="SAFE"; ⊂ Alternarte definitions;
00090 REQUIRE "LPC[X,ALS]" LOAD_MODULE;
00100 REQUIRE "INDAT3[X,ALS]" LOAD_MODULE;
00110 EXTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00120 EXTERNAL PROCEDURE DEFINES;
00130 EXTERNAL PROCEDURE PREPARE;
00140 EXTERNAL INTEGER INFLAG,NX;
00150 FORTRAN REAL PROCEDURE SQRT(REAL X);
00160 FORTRAN REAL PROCEDURE ALOG10(REAL X);
00170 FORTRAN REAL PROCEDURE COS(REAL X);
00180 FORTRAN REAL PROCEDURE SIN(REAL X);
00190 INTEGER ZEROC,ZEROF,DX;
00200 EXTERNAL FORTRAN PROCEDURE LPC(REFERENCE REAL AIFFY,SPT;
00210 REFERENCE INTEGER NPTS,M,NSP);
00220 REQUIRE "FFT8X[X,ALS]" LOAD_MODULE;
00230 EXTERNAL FORTRAN PROCEDURE FRXFM
00240 (REFERENCE INTEGER M;REFERENCE REAL X,Y);
00250 \ INTERNAL REAL ARRAY A,B,C,D[0:512];
00260 REAL X,SX; \ REAL ARRAY WINDOW[0:512];
00270 INTERNAL REAL R0;
00280 INTEGER LPCOPT;
00290 \ INTEGER ARRAY DPYBUF[0:2047];
00300 \ INTEGER ARRAY LFILE[0:'177];
00310 \ INTEGER ARRAY SYMBOL[0:127];
00320 \ INTEGER ARRAY DAT,AVDAT[0:23];
00330 \ INTEGER ARRAY FVAL[0:8];
00340 INTEGER FVAL1,FVAL2;
00350 INTEGER FX,SEGCS;
00360 STRING ARRAY SAMPLE[0:127];
00370 INTEGER I,J,K,L,P,PP,Q,QQ,R,DK,DDK,DDDK,DVAL,DDVAL,DDDVAL,
00380 POINTX,STATE,DELTA,VAL,CHAN1,EOF,POINTT,POINTV;
00390 INTERNAL INTEGER M,N;
00400 INTEGER PT0,PT1,PT2,X0,X1,Y0,Y1,X2,Y2,WFLAG,PERIOD,
00410 PTCNT,PICK,JP,JPX,OPT,OPT1,SHUFCT;
00420 INTEGER II,JJ,KK,NN,SEGC,BRK,EOFA,EOFT,EOFTF,READ3,LX,
00430 SEGTOT,SEGIN,IIT,JJT,KKT,NNT,ITT,JTT,KTT,SEGCT;
00440 BOOLEAN ER;
00450 INTEGER CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,CHANX;
00460 \ INTEGER ARRAY BUF,BUFT,BUFTT[0:511];
00470 STRING FILEN,READ,READ1,READT,READTT,FILEO,READ2,FILEQ,TFILE,FILLST;
00480
00490 PROCEDURE OUTALL(STRING S);
00500 BEGIN
00510 STRING SS; INTEGER J;
00520 SETBREAK(18,0,NULL,"OSN");
00530 SS←SCAN(S,18,J);
00540 OUTSTR(SS);
00550 END;
00560
00570 PROCEDURE DATAIN;
00580 BEGIN
00590 INTEGER J;
00600 FOR J←0 STEP 1 UNTIL 511 DO BUF[J]←0;
00610 ⊂ OUTSTR("To datain with II="&CVS(II)&TB&"SEGC="&CVS(SEGC)&TB&"J="&CVS(J)&CRLF);
00620 IF EOF=0 THEN ARRYIN(CHAN1,BUF[0],512)
00630 ELSE OUTSTR
00640 ("No more data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00650 POINTX←POINT(12,BUF[0],-1);
00660 SEGC←II←II+12; JJ←II+11;
00670 END;
00680
00690
00700 PROCEDURE DTTTIN;
00710 BEGIN
00720 INTEGER J;
00730 IF EOFT=0 THEN ARRYIN(CHAN3,BUFTT[0],512)
00740 ELSE OUTSTR
00750 ("No more .P data with JJ= "&CVS(JJ)&"SEGC= "&CVS(SEGC)&CRLF);
00760 FOR J←0 STEP 1 UNTIL 511 DO IF BUFTT[J]=0 THEN BUFTT[J]←'377777777777;
00770 ITT←BUFTT[0] LSH -15; KTT←0; JTT←BUFTT[511] LSH -15;
00780 ⊂ FOR J←0 STEP 1 UNTIL 10 DO OUTSTR(CVOS(BUFTT[J])&TB);
00790 END;
00800
00810
00820 PROCEDURE SKIP;
00830 BEGIN
00840 INTEGER JJJ;
00850 FOR JJJ←0 STEP 1 UNTIL 127 DO IBP(POINTX);
00860 SEGC←SEGC+1;
00870 ⊃ OUTSTR("Skip to segc= "&CVS(SEGC)&CRLF);
00880 END;
00890
00900
00910 PROCEDURE SHUFFLE;
00920 BEGIN "SHUF"
00930 INTEGER I,J,K;
00940
00950 AIVECT(-599,-360);
00960 I←DPYPTR-PT1; ⊂ Words to save;
00970 J←PT1-PT0; ⊂ Words to overwrite;
00980 FOR K←1 STEP 1 UNTIL I DO DPYBUF[K+3]←DPYBUF[K+3+J];
00990 FOR K←I+1 STEP 1 UNTIL J+I DO DPYBUF[K+3]←1;
01000 PT1←DPYPTR←PT0+I;
01010 DPYOUT(0); PTOCHW(0,'10120);
01020 END "SHUF";
01030
01040 PROCEDURE RARDIS;
01050 BEGIN
01060 INTEGER I,J,K,SP;
01070 INTEGER LY,DY;
01080 REAL MAX,MIN;
01090
01100
01110 MAX←-1000.;MIN←10000.;
01120 FOR I←0 STEP 1 UNTIL 256 DO IF C[I]>MAX THEN MAX←C[I];
01130 SP←6; COMMENT HORIZONTAL SPACING;
01140 FOR I←0 STEP 1 UNTIL 256 DO BEGIN
01150 C[I]←5.5*(C[I]+48-MAX); IF C[I]<0 THEN C[I]←0; END;
01160
01170
01180 RIVECT(35,130);
01190
01200 SETFORMAT(1,0);
01210 ⊂ Write horizantal numbers;
01220 FOR I←0 STEP 1 UNTIL 5 DO BEGIN
01230 DPYSST(CVS(I)); RIVECT(139,0); END; RIVECT(-139,0);
01240 FOR I←6 STEP 1 UNTIL 10 DO BEGIN
01250 RIVECT(36,0); DPYSST(CVS(I)); END; RIVECT(-22,-5);
01260 RIVECT(-512,0); RIVECT(-512,0);
01270
01280 rivect(-1,0); ⊂ Start with 1 off so total will be correct;
01290 ⊂ Draw scale to 5000, with 50 markers to 770;
01300 FOR I←1 STEP 1 UNTIL 5 DO BEGIN
01310 FOR J←1 STEP 1 UNTIL 2 DO BEGIN
01320 FOR K←1 STEP 1 UNTIL 2 DO BEGIN
01330 RIVECT(15,0); RIVECT(0,-10); RVECT(0,10);
01340 RIVECT(16,0); RIVECT(0,-10); RVECT(0,10); END;
01350 RIVECT(15,0); RIVECT(0,-50); RVECT(0,50); END;
01360 RIVECT(0,-264); RVECT(0,264); END;
01370
01380 ⊂ Draw scale from 5000 to 10,000, with 25 markers to 255;
01390 FOR I←1 STEP 1 UNTIL 5 DO BEGIN
01400 FOR J←1 STEP 1 UNTIL 4 DO BEGIN
01410 RIVECT(10,0); RIVECT(0,-10); RVECT(0,10); END;
01420 RIVECT(11,0); RIVECT(0,-264); RVECT(0,264); END;
01430 RVECT(-512,0); RVECT(-512,0);
01440
01450 SETFORMAT(2,0);
01460 ⊂ Vertical numbers and vertical scale;
01470 FOR I←0 STEP 12 UNTIL 42 DO BEGIN
01480 RIVECT(-35,-7); DPYSST(CVS(I)); RIVECT(15,7);
01490 RVECT(-10,0); RIVECT(0,-33);
01500 RIVECT(-35,-7); DPYSST(CVS(I+6)); RIVECT(10,7);
01510 RVECT(-5,0);RIVECT(0,-33); END;
01520 RIVECT(0,264); RVECT(0,-264);
01530 RIVECT(-35,-7); DPYSST(CVS(I)); RIVECT(5,7);
01540 RVECT(512,0); RVECT(512,0); RIVECT(-512,0); RIVECT(-512,0);
01550
01560 LY←C[0]; RIVECT(0,LY);
01570 FOR I←1 STEP 1 UNTIL 128 DO
01580 BEGIN
01590 DY←C[I]-LY;
01600 LY←LY+DY;
01610 RVECT(SP,DY);
01620 END;
01630 SP←2;
01640 FOR I←129 STEP 1 UNTIL 256 DO
01650 BEGIN
01660 DY←C[I]-LY;
01670 LY←LY+DY;
01680 RVECT(SP,DY);
01690 END;
01700 RIVECT(0,108-LY);
01710 DPYOUT(0); PTOCHW(0,'10120);
01720 END "RARDIS";
01730
01740
01750 INTERNAL PROCEDURE FORM(INTEGER LPCOPT);
01760 BEGIN "FORM"
01770 REAL ERRN,ERR;
01780 INTEGER I,J,LP,JJP;
01790
01800 IF LPCOPT=1 THEN BEGIN "FFT"
01810 M←9; N←2↑M; DEFINE PI="3.141592653";
01820 ⊂ OUTSTR("Entering FORM"&CRLF);
01830 IF FX=0 THEN
01840 FOR I←0 STEP 1 UNTIL N DO WINDOW[I]←(1-COS((2*PI*I)/N))/2
01850
01860 ELSE BEGIN N←FVAL[FX+1]-FVAL[FX]; J←0;
01870 FOR I←0 STEP 1 UNTIL FVAL[FX] DO WINDOW[I]←0;
01880 FOR I←FVAL[FX] STEP 1 UNTIL FVAL[FX+1] DO BEGIN
01890 WINDOW[I]←(1-COS((2*PI*J)/N))/2; J←J+1; END;
01900 FOR I←FVAL[FX+1] STEP 1 UNTIL 512 DO WINDOW[I]←0; END;
01910 FOR I←0 STEP 1 UNTIL 512 DO A[I]←D[I];
01920
01930 IF WFLAG=1 THEN BEGIN
01940 AIVECT(-599,0);K←WINDOW[0]*150; RIVECT(0,K);
01950 FOR I←1 STEP 1 UNTIL 350 DO BEGIN
01960 JJP←WINDOW[I]*150;
01970 LP←JJP-K; RVECT(3,LP); K←JJP; END;
01980 RIVECT(-550,-K); RIVECT(-500,0);AIVECT(-599,0);
01990 DPYOUT(0);END;
02000
02010
02020 FOR I←0 STEP 1 UNTIL 512 DO BEGIN
02030 A[I]←D[I]*WINDOW[I]; B[I]←0;
02040 ⊃ SETFORMAT(10,3); ⊃ OUTSTR(CVS(I)&TB&CVG(D[I])&TB&CVG(A[I])&CRLF);
02050 END;
02060
02070 IF WFLAG=1 THEN BEGIN
02080 AIVECT(-569,270);K←A[0]%8; RIVECT(0,K);
02090 FOR I←1 STEP 1 UNTIL 350 DO BEGIN
02100 JJP←A[I]%8;
02110 LP←JJP-K; RVECT(3,LP); K←JJP; END;
02120 RIVECT(-550,-K); RIVECT(-500,0);AIVECT(-599,-360);
02130 DPYOUT(0); END;
02140
02150 FRXFM(M,A[0],B[0]);
02160 ⊃ OUTSTR("FFT COMPLETE"&CRLF);
02170 FOR I←0 STEP 1 UNTIL 256 DO BEGIN
02180 X←(A[I]↑2)+(B[I]↑2)+1.*(10↑-37);
02190 ⊃ OUTSTR(CVG(A[I])&" "&CVG(B[I])&" "&CVG(X)&TB);
02200 C[I]←10.*ALOG10(X); END;
02210
02220 END "FFT" ELSE BEGIN "LPC"
02230
02240 I←FVAL[1]; N←FVAL[2]-FVAL[1];
02250 LPC(D[I],C[0],N,M,256);
02260 END "LPC";
02270
02280 END "FORM";
02290
02300 PROCEDURE MARK;
02310 BEGIN "MARK"
02320 INTEGER I,JJ,K,L,JJP,LP;
02330
02340 ⊂ OUTSTR("Entering MARK"&CRLF);
02350 RIVECT(0,-130); SETFORMAT(3,0);
02360 FOR I←0 STEP 20 UNTIL 340 DO BEGIN
02370 DPYSST(CVS(I)); RIVECT(15,0); END;
02380 RIVECT(-555,30); RIVECT(-500,0);
02390
02400 FOR I←0 STEP 100 UNTIL 300 DO BEGIN "HUNDRED"
02410 RIVECT(0,30); RVECT(0,-30);
02420 FOR JJ←0 STEP 50 UNTIL 50 DO BEGIN "FIFTY"
02430 FOR K←1 STEP 1 UNTIL 5 DO BEGIN "TEN"
02440 RIVECT(15,0); RVECT(0,5); RIVECT(0,-5);
02450 RIVECT(15,0); RVECT(0,10);RIVECT(0,-10);
02460 END "TEN";
02470 RVECT(0,20); RIVECT(0,-20);
02480 IF I≥300 THEN DONE "HUNDRED";
02490 END "FIFTY";
02500 END "HUNDRED";
02510 RIVECT(-550,100); RIVECT(-500,0);
02520
02530 K←D[0]%8; RIVECT(0,K);
02540 FOR I←1 STEP 1 UNTIL 350 DO BEGIN
02550 JJP←D[I]%8;
02560 LP←JJP-K; RVECT(3,LP); K←JJP; END;
02570 RIVECT(-550,-K); RIVECT(-500,0);
02580
02590 PT2←DPYPTR;
02600
02610 RIVECT(500,0);
02620 FOR JJ←1 STEP 1 UNTIL 2 DO BEGIN
02630 L←3*FVAL[JJ]-500;
02640 RIVECT(L,100); RVECT(0,-100); RIVECT(-25,0); RVECT(50,0);
02650 RIVECT(-25,0); RVECT(0,-100); RIVECT(-L,100); END;
02660 RIVECT(-500,0);
02670
02680 PT1←DPYPTR;
02690
02700 DPYOUT(0); PTOCHW(0,'10120);
02710
02720 END "MARK";
02730
02740 INTERNAL PROCEDURE CALCOMP(STRING FILE;INTEGER ARRAY BUFR);
02750 ⊃ Outputs display buffer BUFR to disk file FILE in a format
02760 readable by the Nealy Calcomp plotter program PLTVEC, and by
02770 the Quam Video Synthesizer program MIRTOP;
02780 IF FILE THEN
02790 BEGIN INTEGER DSIZ,CCCHN;
02800 OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
02810 ENTER(CCCHN,FILE&".GRF",0);
02820 OUTSTR("READY TO DPYPARS");
02830 DPYPARS;DSIZ←BUFR[1]+4;
02840 OUTSTR("BACK FROM DPYPARS"&CRLF);
02850 ARRYOUT(CCCHN,BUFR[0],2);WORDOUT(CCCHN,0);
02860 ARRYOUT(CCCHN,BUFR[2],DSIZ-2);
02870 RELEASE(CCCHN);
02880 END "CALCOMP";
02890
02900 PROCEDURE DIN;
02910 BEGIN
02920 INTEGER I,J,K,FX;
02930 REAL VAL;
02940
02950 FX←1; SEGCS←SEGC;
02960 FOR I←0 STEP 1 UNTIL 512 DO D[I]←0;
02970
02980 FOR I←0 STEP 1 UNTIL 3 DO BEGIN
02990 FOR J←0 STEP 1 UNTIL 127 DO BEGIN
03000 VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
03010 D[I*128+J]←VAL; ⊂ OUTSTR(CVS(I*128+J)&TB&CVOS(D[I*128+J])&TB&TB);
03020 END;
03030 ⊂ OUTSTR("In DIN SEGC="&CVS(SEGC)&TB&"JJ="&CVS(JJ)&CRLF);
03040 SEGC←SEGC+1; IF SEGC>JJ THEN DATAIN;
03050 END;
03060
03070 END;
00010 FX←1;
00020 INFLAG←0; PREPARE; INFLAG←1; DEFINES; ⊂ Get names and limits;
00030 FILEN←"HI20.001[CMP,VIN]";
00040 FILEO←"SEG1.FRI";
00050 ⊂ HEADIN;
00060 STDBRK(1);
00070 SETBREAK(14,"∃",NULL,"INS");
00080 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00090 SETBREAK(16,'56,NULL,"INA");
00100 SETBREAK(17,'12,'15,"INS");
00110
00120 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00130 OUTSTR("This program shows header information and wave forms for selected "
00140 &" phones."&crlf&LF);
00150 OUTSTR("At present this program takes acoustic data from [CMP,VIN],"&
00160 CRLF&tb&"indentifying information from MAP.PHM[11,ALS]"&CRLF&
00170 TB&"pulse informstion from .P[PIT,NJM] files"&CRLF&TB&
00180 "and header information from files .T0X[11,ALS]."&CRLF&LF);
00190 OUTSTR("After a display it accepts the following commands"&CRLF&TB&
00200 "Space bar - to continue"&CRLF&TB&
00210 "S - start over"&CRLF&TB&
00220 "E - exit from program"&CRLF&TB&
00230 "a number - go to period nearest this sample number"&CRLF&TB&
00240 "line feed - next pitch period"&CRLF&TB&
00250 "L & # - LPC with # poles (CR for 28)"&CRLF&TB&
00260 "M - go to movable marker mode"&crlf&TB&
00270 "P - prepare file for an XGP plot of screen"&CRLF&TB&
00280 "C - clear FFT display"&CRLF&TB&
00290 "W - write DPYBUF to improve plot"&CRLF&LF);
00300
00310 CLOSE(CHAN4); OPEN(CHAN4,"DSK",1,2,0,3500,BRK,EOFA);
00320 LOOKUP(CHAN4,"MAP.PHN[11,ALS]",ER);
00330 WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find MAP.PHN[11,ALS]. File = ");
00340 LOOKUP(CHAN4,TFILE←INCHWL,ER); END; EOFA←0;
00350 FILLST←INPUT(CHAN4,14);
00360 CLOSE(CHAN4);
00370
00380 FOR I←0 STEP 1 UNTIL 127 DO BEGIN "MAPIN"
00390 WHILE TRUE DO BEGIN
00400 READ1←SCAN(FILLST,17,K);
00410 READ3←READ1[1 TO 1];
00420 IF READ3≠"⊂" THEN DONE; END;
00430 IF READ3="" THEN DONE;
00440 SYMBOL[I]←CVASC(SCAN(READ1,15,K));
00450 SAMPLE[I]←READ1; END "MAPIN";
00460
00470 STARTP:
00480 OUTSTR(CRLF&"Type number of file to start (CR only for 1) ");
00490 IF (READ←INCHWL)="" THEN PP←1 ELSE PP←CVD(READ);
00500
00510 WHILE TRUE DO BEGIN "PICK"
00520 OUTSTR("Select sample # or specify phone (CR only for all phones) ");
00530 JP←FVAL[0]←10000; OPT←OPT1←1; PICK←"";
00540 IF (READ←INCHWL)="" THEN BEGIN OPT←OPT1←0; DONE; END;
00550 READ1←READ[1 TO 1]; IF (READ1≥"0")∧(READ1≤"9") THEN BEGIN
00560 FVAL[0]←CVD(READ); OPT←OPT1←2; DONE END;
00570 PICK←CVASC(READ);
00580 FOR Q←0 STEP 1 UNTIL 127 DO IF PICK=SYMBOL[Q] THEN DONE;
00590 IF Q<128 THEN DONE;
00600 OUTSTR("Not found"&crlf);
00610 END "PICK";
00620
00630 IF OPT≤1 THEN BEGIN
00640 OUTSTR(CRLF&"You have selected "&tb);
00650 IF READ="" THEN BEGIN OPT←0; OUTSTR("Everything"&crlf&LF); END ELSE BEGIN
00660 OUTALL(CVSTR(PICK)&TB&SAMPLE[Q]&CRLF&LF); OPT←OPT1←1; END;
00670 END;
00680
00690 TYPLOC(512,170);
00700
00710 FOR PP←PP STEP 1 UNTIL 26 DO BEGIN "FILEREAD"
00720 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00730 SETFORMAT(-3,0); FILEQ←CVS(PP);
00740 FILEN←FILEN[1 TO 5]&FILEQ&"[CMP,VIN]";
00750 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
00760 WHILE ER DO BEGIN
00770 IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00780 GOTO STARTP; END;
00790 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00800 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
00810 J←K←L←STATE←VAL←R←0;
00820
00830 II←-11; JJ←-1; DATAIN;
00840
00850 SETFORMAT(1,0); FILEQ←CVS(PP);
00860
00870 READT←FILEO[1 TO 3]&FILEQ&".T0X[11,ALS]";
00880 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
00890 LOOKUP(CHAN2,READT,ER); TFILE←READT;
00900 WHILE ER DO BEGIN
00910 IF PP>1 THEN BEGIN OUTSTR("Out of data, will start over."&CRLF);
00920 GOTO STARTP; END;
00930 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
00940 LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
00950 ARRYIN(CHAN2,LFILE[0],'200); ⊂ Input header;
00960 SEGTOT←(LFILE[0]*6)%256;
00970 ⊃ OUTSTR(FILEI&" "&CVS(SEGTOT)&" ");
00980
00990 READ2←READT;
01000 READTT←SCAN(READ2,16,J)&"P[PIT,NJM]";
01010 ⊂ OUTSTR(READTT&CRLF);
01020 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
01030 LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
01040 ITT←JTT←-1000;KTT←0;
01050 IF ER THEN BEGIN
01060 OUTSTR("Using acoustic file "&FILEN&CRLF);
01070 OUTSTR("No .P data (S to start over, space bar to ignore) ");
01080 IF (READ1←INCHRW)="S" THEN GOTO STARTP ELSE BEGIN
01090 BUFTT[0]←'77777; BUFTT[1]←'377777700000;ITT←0; JTT←'3777777;
01100 CLRBUF; END; END;
01110
01120 IIT←-127; JJT←-1; SETFORMAT(3,0); SEGIN←0;
01130
01140 LX←21; PERIOD←200;
01150
01160
01170 WHILE EOF=0 DO Begin "SELECT"
01180 IF OPT≥2 THEN J←FVAL[0]%128+1;
01190 IF OPT=0 THEN BEGIN L←LFILE[LX] LAND '777760000000; END;
01200 IF OPT=1 THEN WHILE TRUE DO BEGIN
01210 IF LFILE[LX]=0 THEN DONE;
01220 L←LFILE[LX] LAND '777760000000;
01230 IF L=PICK THEN DONE;
01240 LX←LX+1;
01250 END;
01260 ⊂ outstr("opt="&cvs(opt)&crlf);
01270 IF OPT≤1 THEN BEGIN
01280 IF LFILE[LX]=0 THEN IF LX>0 THEN DONE "SELECT";
01290 JPX←J←LDB(POINT(14,LFILE[LX],27)); KK←LDB(POINT(8,LFILE[LX],35));
01300 FOR Q←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[Q] THEN DONE;
01310 ⊂ OUTSTR("J="&CVS(J)&CRLF);
01320 END;
01330
01340 ⊂ OUTSTR("SEGC="&CVS(SEGC)&TB&"JJ="&CVS(JJ)&TB&"J="&CVS(J)
01350 ⊂ &TB&"EOF="&CVOS(EOF)&" BEFORE GET"&CRLF);
01360
01370 IF II>J THEN BEGIN
01380 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
01390 LOOKUP(CHAN1,FILEN,ER); TFILE←FILEN;
01400 WHILE ER DO BEGIN
01410 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
01420 LOOKUP(CHAN1,TFILE←INCHWL,ER); END;
01430 II←-11; JJ←-1;
01440 END;
01450
01460 IF IIT>J THEN BEGIN
01470 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOFA);
01480 LOOKUP(CHAN2,READT,ER); TFILE←READT;
01490 WHILE ER DO BEGIN
01500 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
01510 LOOKUP(CHAN2,TFILE←INCHWL,ER); END;
01520 ARRYIN(CHAN2,LFILE[0],'200); ⊂ Input header;
01530 IIT←-127; JJT←-1;
01540 END;
01550
01560 ⊂ OUTSTR("ITT="&CVS(ITT)&TB&"J="&CVS(J)&CRLF);
01570 IF ITT>J*128 THEN BEGIN
01580 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOFT);
01590 LOOKUP(CHAN3,READTT,ER); TFILE←READTT;
01600 WHILE ER DO BEGIN
01610 OUTSTR(CRLF&"Can not find file "&TFILE&" File= ");
01620 LOOKUP(CHAN3,TFILE←INCHWL,ER); END;
01630 ITT←JTT←-1000; KTT←0;
01640 END;
01650
01660 ⊂ OUTSTR("SEGC="&CVS(SEGC)&TB&"JJ="&CVS(JJ)&TB&"J="&CVS(J)&
01670 ⊂ TB&"EOF="&CVOS(EOF)&" before DATAIN"&CRLF);
01680 ⊂ OUTSTR("JTT="&CVS(JTT)&TB&"J="&CVS(J)&CRLF);
01690 WHILE JJ<J DO DATAIN;
01700 ⊂ OUTSTR("JJ="&CVS(JJ)&TB&"J="&CVS(J)&" after DATAIN"&CRLF);
01710 WHILE JTT<(J-1)*128 DO DTTTIN;
01720 ⊂ OUTSTR(" and after JTT="&CVS(JTT)&CRLF);
01730
01740
01750 IF SEGC>J THEN BEGIN
01760 POINTX←POINT(12,BUF[0],-1);
01770 SEGC←II; JJ←II+11; END;
01780
01790 WHILE SEGC<J DO SKIP;
01800
01810 IF OPT=3 THEN BEGIN "OPT3"
01820 FVAL[1]←FVAL[0]-(SEGC-1)*128;
01830 IF FVAL[1]<0 THEN FVAL[1]←0;
01840 WHILE TRUE DO BEGIN
01850 IF (FVAL[5]←BUFTT[KTT] LSH -15)≥J*128 THEN DONE;
01860 IF (KTT←KTT+1)≥512 THEN DTTTIN;
01870 END;
01880 FVAL[2]←FVAL[5]-(SEGC-1)*128;
01890 END "OPT3" ELSE BEGIN "OPTLOW"
01900
01910 WHILE (BUFTT[KTT] LSH -15)≥J*128 DO BEGIN
01920 IF KTT=0 THEN DONE; KTT←KTT-1; END;
01930 WHILE TRUE DO BEGIN
01940 IF (FVAL[4]←BUFTT[KTT] LSH -15)≥(J-1)*128 THEN DONE;
01950 IF (KTT←KTT+1)≥512 THEN DTTTIN; END;
01960 IF FVAL[4]≥(J+1)*128 THEN BEGIN
01970 OUTSTR("No pitch markers in range. Starting at specified location."&CRLF);
01980 IF OPT=2 THEN FVAL[1]←FVAL[0]-(SEGC-1)*128 ELSE FVAL[1]←0;
01990 END ELSE BEGIN
02000 IF FVAL[4]>J*128 THEN SKIP;
02010 FVAL[1]←FVAL[4]-(SEGC-1)*128; END;
02020 FVAL[2]←(BUFTT[KTT+1] LSH -15)-(SEGC-1)*128;
02030 END "OPTLOW";
02040
02050 IF FVAL[2]-FVAL[1]>PERIOD*3%2 THEN BEGIN
02060 FVAL[2]←FVAL[1]+PERIOD;
02070 OUTSTR("A second marker was not in range so will use a period of "
02080 &cvs(period)&" samples."&CRLF); END;
02090
02100 PERIOD←(PERIOD+FVAL[2]-FVAL[1])%2;
02110
02120 FVAL[4]←FVAL[1]+(SEGC-1)*128;
02130 FVAL[5]←FVAL[2]+(SEGC-1)*128;
02140 OUTSTR("Markers are at "&CVS(FVAL[4])&" and "&CVS(FVAL[5]));
02150
02160 IF OPT≥2 THEN BEGIN
02170 FOR Q←21 STEP 1 UNTIL 127 DO BEGIN
02180 IF LFILE[Q]=0 THEN DONE;
02190 IF (I←LDB(POINT(14,LFILE[Q],27))*128)
02200 +LDB(POINT(8,LFILE[Q],35))*128> FVAL[1]+(SEGC-1)*128 THEN DONE; END;
02210 IF I<FVAL[2]+(SEGC-1)*128 THEN
02220 L←LFILE[Q] LAND '777760000000 ELSE L←"";
02230 FOR Q←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[Q] THEN DONE; END;
02240 IF L≠"" THEN OUTALL(" designated as the phone "&CVSTR(L)) else
02250 OUTSTR(" undesignated");
02260 OUTSTR(" in file "&CVS(PP)&CRLF);
02270
02280
02290 SETFORMAT(3,0);
02300
02310 DIN;
02320 ⊂ FOR I←0 STEP 1 UNTIL 511 DO OUTSTR(CVOS(D[I])&TB);
02330 DPYSET(DPYBUF); AIVECT(-599,0); MARK;
02340
02350 ⊂ Begin show;
02360 WHILE TRUE DO BEGIN "SHOW"
02370 ⊂ OUTSTR("Entering SHOW"&CRLF);
02380 AIVECT(-599,-340); FORM(1);
02390 WHILE TRUE DO BEGIN "SHOWL"
02400 PREPARE;
02410 RARDIS;
02420
02430 DPYOUT(0);
02440
02450
02460 FOR I←0 STEP 1 UNTIL 9 DO OUTALL(CVSTR(INNAME[I])&TB); OUTSTR(CRLF);
02470 FOR I←0 STEP 1 UNTIL 9 DO OUTALL(CVS(INDATA[I])&TB); OUTSTR(CRLF&LF);
02480 FOR I←10 STEP 1 UNTIL 14 DO OUTALL(CVSTR(INNAME[I])&TB); OUTSTR(CRLF);
02490 FOR I←10 STEP 1 UNTIL 14 DO OUTSTR(CVS(INDATA[I])&TB); OUTSTR(CRLF);
02500
02510 PTOCHW(0,'10120);
02520 OUTSTR(
02530 "E to exit, LF to step, space to cont., # for #,"
02540 &" L# FOR #pole LPC, S to start"&crlf);
02550
02560 READ1←INCHRW;
02570 IF (READ1="E")∨(READ1="e") THEN GOTO STOPP;
02580 WHILE (READ1="W")∨(READ1="w") DO BEGIN DPYOUT(0) ;
02590 PTOCHW(0,'10120);READ1←INCHRW; END;
02600
02610 IF READ1="C" THEN BEGIN
02620 FOR I←PT1+1 STEP 1 UNTIL DPYPTR DO DPYBUF[I+3]←1;
02630 DPYPTR←PT1;
02640 DPYOUT(0); PTOCHW(0,'10120);
02650 READ1←INCHRW;
02660 END;
02670
02680 IF (READ1="P")∨(READ1="p") THEN BEGIN CALCOMP("PLOTX",DPYBUF);
02690 OUTSTR("EX DPYXGP[X,ALS] plots PLOTX.GRF on the XGP. Next command please."&CRLF);
02700 READ1←INCHRW; END;
02710 IF (READ1="M")∨(READ1="m") THEN BEGIN
02720 ⊂ I←DPYPTR;
02730 ⊂ FOR K←PT2+1 STEP 1 UNTIL I DO DPYBUF[K+3]←1;
02740 AIVECT(-599,0); READ1←"NO";
02750 FOR I←1 STEP 1 UNTIL 2 DO BEGIN
02760 WHILE TRUE DO BEGIN
02770 IF READ1≠"" THEN BEGIN
02780 DPYPTR←PT2; RIVECT(500,0);
02790 FOR JJ←1 STEP 1 UNTIL 2 DO BEGIN
02800 L←3*FVAL[JJ]-500;
02810 RIVECT(L,100); RVECT(0,-100); RIVECT(-25,0); RVECT(50,0);
02820 RIVECT(-25,0); RVECT(0,-100); RIVECT(-L,100); END;
02830 RIVECT(-500,0);
02840 DPYOUT(0);
02850 END;
02860 IF FVAL[I]=0 THEN OUTSTR("Specify position of marker #"&
02870 CVS(I)&" ") ELSE OUTSTR("Move marker #"&CVS(I)&" (CR if OK) ");
02880 IF (READ1←INCHWL)="" THEN DONE;
02890 FVAL[I]←FVAL[I]+CVD(READ1);
02900 END;
02910 END;
02920 CONTINUE "SHOW"; END;
02930
02940 K←CVASC(READ1);
02950
02960 IF K≥CVASC("0") THEN IF K≤CVASC("9") THEN BEGIN
02970 FVAL[0]←CVD(READ1&INCHWL); OPT←2;
02980 CONTINUE "SELECT"; END;
02990 OUTSTR(CR);
03000
03010 IF READ1=" " THEN BEGIN
03020 OPT←OPT1;
03030 IF OPT≤1 THEN BEGIN LX←LX+1;
03040 IF LFILE[LX]=0 THEN DONE "SELECT";
03050 END ELSE BEGIN
03060 OPT←3; FVAL[0]←FVAL[2]+(SEGCS-1)*128; END;
03070 CONTINUE "SELECT"; END;
03080
03090 IF (READ1='15)∨(READ1='12) THEN BEGIN
03100 FVAL[0]←FVAL[2]+(SEGCS-1)*128; OPT←3;
03110 CLRBUF; CONTINUE "SELECT"; END;
03120 TOFORM:
03130 IF (READ1="L")∨(READ1="l") THEN BEGIN
03140 IF (READ1←INCHWL)="" THEN M←28 ELSE M←CVD(READ1);
03150 AIVECT(-599,-340); FORM(0); CLRBUF; CONTINUE "SHOWL"; END;
03160
03170 IF (READ1="S")∨(READ1="s") THEN BEGIN
03180 OUTSTR(LF&"You are starting over"&CRLF); CLRBUF;
03190 GOTO STARTP; END;
03200 END "SHOWL";
03210 END "SHOW";
03220 END "SELECT";
03230 END "FILEREAD";
03240
03250 OUTSTR("Data are exhausted"&CRLF&LF); GOTO STARTP;
03260 STOPP: RELEASE(CHAN1);RELEASE(CHAN2);RELEASE(CHAN3);RELEASE(CHAN4);
03270 PTOCHW(0,'10103); PTOCHW(0,'10120);
03280
03290 END "PLOT";
03300
03310